home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / elecTemplates.tcl < prev    next >
Encoding:
Text File  |  1998-12-15  |  17.0 KB  |  603 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #    Vince's    Additions -    an extension package for Alpha
  4.  # 
  5.  #    FILE: "elecTemplates.tcl"
  6.  #                    created: 24/2/97 {1:34:29 pm}    
  7.  #                  last update: 15/12/1998 {10:59:05 pm}    
  8.  #    Author:    Vince Darley
  9.  #    E-mail:    <darley@fas.harvard.edu>
  10.  #      mail:    Division of    Applied    Sciences, Harvard University
  11.  #            Oxford Street, Cambridge MA    02138, USA
  12.  #       www:    <http://www.fas.harvard.edu/~darley/>
  13.  #    
  14.  #  Routines for electric insertions, and keeping track of template
  15.  #  positions.    
  16.  # ###################################################################
  17.  ##
  18.  
  19. alpha::feature betterTemplates 9.2 global {
  20.     alpha::package require elecBindings 9.0
  21.     alpha::useElectricTemplates
  22.     lunion varPrefs(Electrics) [list "Better Templates:" stopNavigationMsgOff \
  23.       templateStopColor maxTemplateNesting \
  24.       TemplatePrompts TemplateWrappers]
  25.     # colour of template stops (magenta default)
  26.     newPref var templateStopColor 4 global "" alpha::basiccolors varindex
  27.     # level of nesting we allow before clearing
  28.     newPref var maxTemplateNesting 5
  29.     ## 
  30.      # The format of the template stops:
  31.      #     (a) just use bullets
  32.      #     (b) use bullets but signal the name in the status window
  33.      #     (c) insert names into the window with the bullets
  34.      #     (d) insert names and highlight into the window with the bullets
  35.      ##
  36.     newPref var TemplatePrompts 1 global "" [list {Just use bullets} \
  37.       {Use bullets and status window prompt} {Put prompts in the text} \
  38.       {Highlight prompts in the text}] index
  39.     # Visual appearance of templates in the text
  40.     newPref var TemplateWrappers 0 global ring::_changeTemplateWrappers \
  41.       [list {<Angle brackets>} {“Curly quotes”} {«Curly brackets»} ] index
  42.     # Don't bother with the basic 'hit tab to go to next stop...' message
  43.     newPref flag stopNavigationMsgOff 0 global ring::setTemplateMessage
  44. } {
  45.     # so we force a reload of this file when necessary
  46.     if {[info commands ring::setTemplateMessage] != ""} {
  47.     rename ring::setTemplateMessage ""
  48.     }
  49.     ring::setTemplateMessage
  50.     # setup template wrappers
  51.     ring::_changeTemplateWrappers
  52.     # call on close to clear the stop ring.
  53.     hook::register closeHook ring::unsetName    
  54. } {
  55.     hook::deregister closeHook ring::unsetName
  56.     # source old code since we over-rode it below.
  57.     source [file join $HOME Tcl SystemCode templates.tcl]
  58. } maintainer {
  59.     "Vince Darley" darley@fas.harvard.edu <http://www.fas.harvard.edu/~darley/>
  60. } uninstall this-file help {file "ElecCompletions Help"}
  61.  
  62. # we don't want to be auto-loaded unless we're active.
  63. #if {![package::active betterTemplates]} { 
  64. #    alertnote "Something's trying to auto-load the betterTemplates extension\
  65. #      but it's not active!"
  66. #    return 
  67. #}
  68.  
  69. # indicates we're a better ring
  70. proc ring::type {} { return 1 }
  71.  
  72. proc ring::isNested {p} {
  73.     if {![catch {ring::minmax} mm] \
  74.       && [pos::compare $p >= [lindex $mm 0]] \
  75.       && [pos::compare $p <= [lindex $mm 1]]} {
  76.     return 1
  77.     } else {
  78.     ring::clear
  79.     return 0
  80.     }
  81. }
  82.  
  83. proc ring::nestedPos {pos} {
  84.     if {[catch {
  85.     set p [tmark::getPositions {nestStart nestEnd}]
  86.     if {[pos::compare $pos < [lindex $p 0]]} { return -1 }
  87.     if {[pos::compare $pos > [lindex $p 1]]} { return -1 }
  88.     }]} { return -1 }
  89.     set positions [ring::orderAndPositions]
  90.     if {$positions == "" || [pos::compare $pos < [lindex $positions 0]] \
  91.       || [pos::compare $pos >= [lindex $positions end]]} {
  92.     return -1
  93.     } else {
  94.     set i 0
  95.     while {[pos::compare $pos >= [lindex $positions $i]]} {incr i}
  96.     return $i
  97.     }
  98. }
  99.  
  100. proc ring::minmax {} {
  101.     return [tmark::getPositions {nestStart nestEnd}]
  102. }
  103. proc ring::getlist {} {
  104.     # get a local reference to the window's stopRing
  105.     upvar \#0 __elecRing([ring::winName]) s
  106.     if {![info exists s]} {
  107.     return [ring::clear]
  108.     }
  109.     set s
  110. }
  111.  
  112. proc ring::clear {} {
  113.     set x [ring::winName]
  114.     # get a local reference to the window's stopRing
  115.     upvar \#0 __elecRing($x) s
  116.     if {[info exists s] && $s != ""} {
  117.     ring::_ensure_no_bullets $s
  118.     }
  119.     set s ""
  120.     upvar \#0 __elecRingPrompts$x w
  121.     if {[info exists w]} {unset w}
  122.     global __elecNestingLevel __elecLastStop
  123.     set __elecNestingLevel($x) 0
  124.     set __elecLastStop($x) ""
  125.     
  126.     removeTMark "nestStart"
  127.     removeTMark "nestEnd"
  128. }
  129.  
  130. proc ring::unsetName {name} {
  131.     ring::unseti [join [file tail $name] ""]
  132. }
  133.  
  134. proc ring::unseti {x} {
  135.     global __elecRing __elecNestingLevel __elecLastStop __elecRingPrompts$x
  136.     if {[info exists __elecRing($x)]} {
  137.     unset __elecRing($x)
  138.     }
  139.     if {[info exists __elecNestingLevel($x)]} {
  140.     unset __elecNestingLevel($x)
  141.     }
  142.     if {[info exists __elecLastStop($x)]} {
  143.     unset __elecLastStop($x)
  144.     }
  145.     if {[info exists __elecRingPrompts$x]} {
  146.     unset __elecRingPrompts$x
  147.     }
  148. }
  149.  
  150. proc ring::_ensure_no_bullets {stops} {
  151.     message "Deleting non-nested prompts…"
  152.     createTMark "_deleting_" [getPos]
  153.     foreach stop $stops {
  154.     if {![catch {tmark::getPos $stop} p]} {
  155.         ring::_deleteBullet $p
  156.         removeTMark $stop
  157.     }    
  158.     }
  159.     message ""
  160.     gotoTMark "_deleting_"
  161.     removeTMark "_deleting_"
  162. }
  163.  
  164. ## 
  165.  # -------------------------------------------------------------------------
  166.  # 
  167.  # "ring::replaceStopMatches" --
  168.  # 
  169.  #  Replace all stops which match 'stoppat' (a simple glob like pattern)
  170.  #  with the text '$text'.  The stops are permanently deleted.
  171.  # -------------------------------------------------------------------------
  172.  ##
  173. proc ring::replaceStopMatches {stoppat text} {
  174.     # get a local reference to the window's stopRing
  175.     set x [ring::winName]
  176.     upvar \#0 __elecRing($x) s
  177.     if {[info exists s]} {
  178.     pushPosition
  179.     upvar \#0 __elecRingPrompts$x w
  180.     set i 0
  181.     foreach stop $s {
  182.         if {[string match $stoppat $w($stop)]} {
  183.         if {![catch {tmark::getPos $stop} p]} {
  184.             if {[ring::_deleteBullet $p]} {
  185.             insertText $text
  186.             }
  187.             removeTMark $stop
  188.             set s [lreplace $s $i $i]
  189.             incr i -1
  190.         }    
  191.         }
  192.         incr i
  193.     }    
  194.     popPosition
  195.     } else {
  196.     ring::clear
  197.     } 
  198. }
  199.  
  200. proc ring::winName {} { return [join [win::CurrentTail] ""] }
  201.  
  202. proc ring::order {} {
  203.     # get a local reference to the window's stopRing
  204.     upvar \#0 __elecRing([ring::winName]) s
  205.     if {[info exists s]} {
  206.     for {set i 0} {$i <100} {incr i} {
  207.         if {[set lpos [lsearch -exact $s stop0:${i}]] != -1 } {
  208.         set s [concat [lrange $s $lpos end] [lrange $s 0 [incr lpos -1]]]
  209.         return $s
  210.         }
  211.     }
  212.     } else {
  213.     ring::clear
  214.     } 
  215. }
  216.  
  217. proc ring::orderAndPositions {} {
  218.     # get a local reference to the window's stopRing
  219.     upvar \#0 __elecRing([ring::winName]) s
  220.     if {[info exists s] && ([string trim $s] != {}) } {
  221.     set positions [tmark::getPositions $s]
  222.     set max -1
  223.     set idx 0
  224.     set lpos -1
  225.     foreach st $s {
  226.         if {[pos::compare [set p [lindex $positions $idx]] > $max]} {
  227.         set max $p
  228.         set lpos $idx
  229.         }
  230.         incr idx
  231.     }
  232.     set s [concat [lrange $s [expr {$lpos +1}] end] [lrange $s 0 $lpos]]
  233.     set positions [concat [lrange $positions [expr {$lpos +1}] end] \
  234.       [lrange $positions 0 $lpos]]
  235.     return $positions
  236.     } else {
  237.     ring::clear
  238.     return ""
  239.     } 
  240. }
  241.  
  242. ## 
  243.  # -------------------------------------------------------------------------
  244.  # 
  245.  # "ring::_deleteBullet" --
  246.  # 
  247.  #  Deletes the bullet and a following tag-prompt.  The mark moves to the
  248.  #  location of the deleted text (side-effect).  Returns '1' if the deletion
  249.  #  was successful, else '0'.
  250.  # -------------------------------------------------------------------------
  251.  ##
  252. proc ring::_deleteBullet {p {h 0}} {
  253.     global elecStopMarker
  254.     if {[lookAt $p] == $elecStopMarker} {
  255.     global ring::_tstart ring::_tmatch
  256.     if {[lookAt [pos::math $p + 1]] == ${ring::_tstart} } {
  257.         set    ppos [search -s -f 1 -r 1 -l [pos::math $p + 80] -n ${ring::_tmatch} $p]
  258.         if {[pos::compare [lindex $ppos 0] == $p]} {
  259.         if $h {
  260.             eval select $ppos
  261.         } else {
  262.             eval deleteText $ppos
  263.         }
  264.         return 1
  265.         }
  266.     }
  267.     deleteText $p [pos::math $p + 1]
  268.     return 1
  269.     }
  270.     return 0
  271. }
  272.  
  273. proc ring::_goto {rest} {
  274.     global __elecLastStop ring::_templateMessage TemplatePrompts
  275.     set x [ring::winName]
  276.     gotoTMark [set __elecLastStop($x) $rest]
  277.     # remove the stop '•' plus optional prompt-tag.
  278.     ring::_deleteBullet [getPos] [expr {$TemplatePrompts == 3}]
  279.     if $TemplatePrompts {
  280.     upvar \#0 __elecRingPrompts$x w
  281.     if {$w($rest) != ""} {
  282.         message "Fill in '$w($rest)'${ring::_templateMessage}"
  283.     } else {
  284.         message "Fill in template stop${ring::_templateMessage}"
  285.     }
  286.     }
  287. }
  288.  
  289. proc ring::nth {} {
  290.     # get a local reference to the window's stopRing
  291.     set x [ring::winName]
  292.     upvar \#0 __elecRing($x) s
  293.     upvar \#0 __elecRingPrompts$x w
  294.     foreach f $s {
  295.     if {$w($f) != ""} {
  296.         lappend l "$f -- $w($f)"
  297.     } else {
  298.         lappend l "$f -- (no prompt)"
  299.     }
  300.     }
  301.     if {![info exists l]} { beep; message "No template stops exist." }
  302.     set item [lindex [listpick -p "Pick a stop (listed from current pos)…" $l] 0]
  303.     ring::goTo $item
  304. }
  305. proc ring::goTo {stop} {
  306.     # get a local reference to the window's stopRing
  307.     upvar \#0 __elecRing([ring::winName]) s
  308.     if {[info exists s]} {
  309.     if { [set lpos [lsearch -exact $s $stop]] != -1 } {
  310.         set s [concat [lrange $s $lpos end] [lrange $s 0 [incr lpos -1]]]
  311.         ring::_goto $stop
  312.     }
  313.     } else {
  314.     ring::clear
  315.     } 
  316. }
  317.  
  318. ## 
  319.  # -------------------------------------------------------------------------
  320.  # 
  321.  # "ring::TMarkAt" --
  322.  # 
  323.  #  Is the template stop with prompt 'name' at position 'pos'.  The 'name'
  324.  #  is the name of the enclosed prompt as in '•environment name•', but
  325.  #  without the bullets.  It is matched via 'string match'.
  326.  # -------------------------------------------------------------------------
  327.  ##
  328. proc ring::TMarkAt {name pos} {
  329.     set stop [tmark::isAt $pos]
  330.     if {$stop != ""} {
  331.     set x [ring::winName]
  332.     upvar \#0 __elecRingPrompts$x w
  333.     return [string match $name $w($stop)]
  334.     } else {
  335.     return 0
  336.     }
  337. }
  338.  
  339. proc ring::+ {} {
  340.     # get a local reference to the window's stopRing
  341.     upvar \#0 __elecRing([ring::winName]) s
  342.     set first [lindex $s 0]
  343.     set s [lreplace $s 0 0]
  344.     lappend s $first
  345.     set next [lindex $s 0]
  346.     ring::_goto $next
  347. }
  348. proc ring::- {} {
  349.     # get a local reference to the window's stopRing
  350.     upvar \#0 __elecRing([ring::winName]) s
  351.     #set end [expr {[llength $s] - 1}]
  352.     set last [lindex $s end]
  353.     set s [lreplace $s end end]
  354.     set s [linsert $s 0 $last]
  355.     ring::_goto $last
  356. }
  357.  
  358. proc ring::deleteBulletAndMove {} {
  359.     ring::_deleteBullet [getPos]
  360.     ring::+
  361. }
  362.  
  363. proc ring::deleteStopAndMove {} {
  364.     ring::_deleteStop
  365.     upvar \#0 __elecRing([ring::winName]) s
  366.     ring::_goto [lindex $s 0]
  367. }
  368.  
  369. proc ring::deleteStop {} {
  370.     ring::_deleteStop
  371. }
  372.  
  373. proc ring::_deleteStop {} {
  374.     global __elecLastStop
  375.     set x [ring::winName]
  376.     # get a local reference to the window's stopRing
  377.     upvar \#0 __elecRing($x) s
  378.     set l [lsearch -exact $s $__elecLastStop($x)]
  379.     if {$l != -1 } {
  380.     global TemplatePrompts
  381.     if {$TemplatePrompts == 3} {
  382.         ring::_deleteBullet [getPos]
  383.     }
  384.     set s [lreplace $s $l $l]
  385.     removeTMark $__elecLastStop($x)
  386.     set __elecLastStop($x) ""
  387.     }
  388. }
  389.  
  390. proc ring::insert {rest {goto 1}} {
  391.     global __elecNestingLevel __elecCurrentNesting maxTemplateNesting \
  392.       elecStopMarker
  393.     # get a local reference to the window's stopRing
  394.     set x [ring::winName]
  395.     upvar \#0 __elecRing($x) s
  396.     # if not nested, clear everything
  397.     if {[set p [ring::nestedPos [getPos]]] == "-1" \
  398.       || [incr __elecNestingLevel($x)] > $maxTemplateNesting } {
  399.     ring::clear
  400.     set p 0
  401.     }
  402.     set _level $__elecNestingLevel($x)
  403.     # preliminaries
  404.     set pos [getPos]
  405.     set ii [set i 0] 
  406.     upvar \#0 __elecRingPrompts$x w
  407.     global __elecPrompts
  408.     if {![info exists __elecPrompts]} {
  409.     set __elecPrompts ""
  410.     }
  411.     # do the stop ring, extracting prompts from '__elecPrompts'
  412.     while {[regexp -indices $elecStopMarker $rest I] == 1} {
  413.     regsub $elecStopMarker $rest "o" rest
  414.     createTMark "stop${_level}:$i" [pos::math $pos + [lindex $I 0]]
  415.     lappend ss "stop${_level}:$i"
  416.     set w(stop${_level}:$i) [lindex $__elecPrompts $i]
  417.     #set __elecPrompts [lrange $__elecPrompts 1 end]
  418.     incr i
  419.     }
  420.     if {$i > 2 || ($i == 2 && $_level == 0)} {
  421.     # store insertion's min and max, if we have more than two stops
  422.     createTMark "nestStart" $pos
  423.     createTMark "nestEnd" [pos::math $pos + [string length $rest]]
  424.     }
  425.     # put the stop ring together
  426.     set s [concat $ss [lrange $s $p end] [lrange $s 0 [expr {$p -1}]]]
  427.     # forget the prompt list (we've stored them in an array)
  428.     unset __elecPrompts
  429.     # goto the first stop we just inserted
  430.     if $goto {
  431.     ring::_goto "stop${_level}:${ii}"
  432.     }
  433. }
  434.  
  435.  
  436. proc ring::_changeTemplateWrappers {{flag ""}} {
  437.     global flag::list TemplateWrappers elecStopMarker
  438.     set wrap [lindex [lindex [set flag::list(TemplateWrappers)] 1] $TemplateWrappers]
  439.     global ring::_tstart ring::_tend ring::_tmatch
  440.     set a [string index $wrap 0]
  441.     set b [string index $wrap [expr {[string length $wrap] -1}]]
  442.     
  443.     set "ring::_tstart" $a
  444.     set "ring::_tend" $b
  445.     #     set "ring::_tmatch" "•${a}\[^${a}${b}\]*${b}"
  446.     set "ring::_tmatch" "(${elecStopMarker}${a}\[^${a}${b}]*${b}|${elecStopMarker}${a}(\[^${a}${b}\]*(${a}\[^${a}${b}\]*${b})\[^${a}${b}\]*)*${b})"
  447. }
  448.  
  449. proc ring::setTemplateMessage {} {
  450.     global electricBindings ring::_templateMessage stopNavigationMsgOff
  451.     set ring::_templateMessage [lindex \
  452.       {", press Tab (shift-Tab) to move to the next (previous) stop." \
  453.       ", press ctrl-j (shift-ctrl-j) to move to the next (previous) stop." \
  454.       ", press user-defined keys to move from stop to stop." } \
  455.       $electricBindings]
  456.     if {$stopNavigationMsgOff} {
  457.     set ring::_templateMessage ""
  458.     } 
  459. }
  460.  
  461.  
  462.  
  463. ## 
  464.  # -------------------------------------------------------------------------
  465.  #     
  466.  #    "elec::_Insertion" --
  467.  #    
  468.  #     Insert    a piece    of text, padding on    the    left appropriately.     The text 
  469.  #     should    already    be correctly indented within itself.  
  470.  # -------------------------------------------------------------------------
  471.  ##
  472. proc elec::_Insertion { center args } {
  473.     global __elecPrompts TemplatePrompts elecStopMarker
  474.     set text [join $args ""]
  475.     set pos [getPos]
  476.     regsub -all "\t" $text [text::Tab] text
  477.     if {[regexp "\[\n\r\]" $text]} {
  478.     regsub -all "\[\n\r\]" $text "\r[text::indentTo $pos]" text
  479.     }
  480.     if {[regexp "…" $text]} {
  481.     regsub -all "…" $text [text::halfTab] text
  482.     }
  483.     if {![regexp "•" $text] || ([regexp {^([^•]*)••$} $text "" text])} {
  484.     setMark
  485.     insertText $text
  486.     if $center { centerRedraw }
  487.     return
  488.     }
  489.     switch -- $TemplatePrompts {
  490.     0 {
  491.         set t $text
  492.         regsub -all {•[^•]*•} $text $elecStopMarker text
  493.         insertText $text
  494.         while {[regexp {^([^•]*)•([^•]*)•(.*)$} $t "" tt hyper t]} {
  495.         lappend __elecPrompts $hyper
  496.         }
  497.     }
  498.     1 {
  499.         while {[regexp {^([^•]*)•([^•]*)•(.*)$} $text "" tt hyper text]} {
  500.         lappend __elecPrompts $hyper
  501.         append t "${tt}$elecStopMarker"
  502.         lappend colours [list [string length $tt] 1]
  503.         }
  504.         append t $text
  505.     }
  506.     2 -
  507.     3 {
  508.         global ring::_tstart ring::_tend
  509.         while {[regexp {^([^•]*)•([^•]*)•(.*)$} $text "" tt hyper text]} {
  510.         lappend __elecPrompts $hyper
  511.         if {$hyper != ""} {
  512.             append t "${tt}${elecStopMarker}${ring::_tstart}${hyper}${ring::_tend}"
  513.             lappend colours [list [string length $tt] \
  514.               [expr {3 + [string length $hyper]}]]
  515.         } else {
  516.             append t "${tt}${elecStopMarker}"
  517.             lappend colours [list [string length $tt] 1]
  518.         }
  519.         }
  520.         append t $text
  521.     }
  522.     }
  523.     if {$TemplatePrompts} {
  524.     set p $pos
  525.     # we insert in one chunk so undoing is easy.
  526.     insertText $t
  527.     global templateStopColor
  528.     if {$templateStopColor} {
  529.         foreach col $colours {
  530.         set p [pos::math $p + [lindex $col 0]]
  531.         insertColorEscape $p $templateStopColor
  532.         set p [pos::math $p + [lindex $col 1]]
  533.         insertColorEscape $p 0
  534.         }
  535.     }
  536.     
  537.     set text $t
  538.     }
  539.     
  540.     goto $pos
  541.     if $center { centerRedraw }
  542.     ring::insert $text
  543. }
  544.  
  545.  
  546. # ◊◊◊◊ possible tab key bindings ◊◊◊◊ #
  547. # note: Also provided by the base Alpha system, these overide when 
  548. # Univs Completions package is in use (these may be more intricate).
  549.  
  550. ## 
  551.  # -------------------------------------------------------------------------
  552.  #     
  553.  #    "bind::IndentOrNextstop" --
  554.  #    
  555.  #     Either    insert a real tab if your mode hasn't defined its electricTab
  556.  #     variable, or jump to the next template    stop (if we're mid-template),
  557.  #     or    indent the current line    correctly.
  558.  # -------------------------------------------------------------------------
  559.  ##
  560. proc bind::IndentOrNextstop {{hard 0}} {
  561.     global electricTab
  562.     if {$hard || !$electricTab} {
  563.     insertActualTab 
  564.     } else {
  565.     global tabNeverIndents
  566.     if {[info exists tabNeverIndents] && $tabNeverIndents} { return [ring::+] }
  567.     if {[ring::isNested [getPos]]} {
  568.         ring::+
  569.     } else {
  570.         bind::IndentLine
  571.     }
  572.     }
  573. }
  574.  
  575. ## 
  576.  # -------------------------------------------------------------------------
  577.  #     
  578.  #    "bind::TabOrComplete" --
  579.  #    
  580.  #     Either    insert a real tab if your mode hasn't defined its electricTab
  581.  #     variable, or invoke the completion mechanism, or indent the current 
  582.  #     line correctly.
  583.  # -------------------------------------------------------------------------
  584.  ##
  585. proc bind::TabOrComplete {{hard 0}} {
  586.     global electricTab
  587.     if {$hard || !$electricTab} {
  588.     insertActualTab 
  589.     } else {
  590.     bind::Completion
  591.     }
  592. }
  593.  
  594.  
  595.  
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602.  
  603.